home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / tcl / tcl70b2.lha / tcl7.0b2 / tclMtherr.c < prev    next >
C/C++ Source or Header  |  1993-07-19  |  3KB  |  92 lines
  1. /* 
  2.  * tclMatherr.c --
  3.  *
  4.  *    This function provides a default implementation of the
  5.  *    "matherr" function, for SYS-V systems where it's needed.
  6.  *
  7.  * Copyright (c) 1993 The Regents of the University of California.
  8.  * All rights reserved.
  9.  *
  10.  * Permission is hereby granted, without written agreement and without
  11.  * license or royalty fees, to use, copy, modify, and distribute this
  12.  * software and its documentation for any purpose, provided that the
  13.  * above copyright notice and the following two paragraphs appear in
  14.  * all copies of this software.
  15.  * 
  16.  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  17.  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  18.  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  19.  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  20.  *
  21.  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  22.  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  23.  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  24.  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  25.  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  26.  */
  27.  
  28. #ifndef lint
  29. static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclMtherr.c,v 1.4 93/07/19 14:58:45 ouster Exp $ SPRITE (Berkeley)";
  30. #endif /* not lint */
  31.  
  32. #include "tclInt.h"
  33. #include <math.h>
  34.  
  35. /*
  36.  * The stuff below is a bit of a hack so that this file can be used
  37.  * in environments that include no UNIX, i.e. no errno.  Just define
  38.  * errno here.
  39.  */
  40.  
  41. #ifndef TCL_GENERIC_ONLY
  42. #include "tclUnix.h"
  43. #else
  44. int errno;
  45. #define EDOM 33
  46. #define ERANGE 34
  47. #endif
  48.  
  49. /*
  50.  * The following variable is secretly shared with Tcl so we can
  51.  * tell if expression evaluation is in progress.  If not, matherr
  52.  * just emulates the default behavior, which includes printing
  53.  * a message.
  54.  */
  55.  
  56. extern int tcl_MathInProgress;
  57.  
  58.  
  59. /*
  60.  *----------------------------------------------------------------------
  61.  *
  62.  * matherr --
  63.  *
  64.  *    This procedure is invoked on Sys-V systems when certain
  65.  *    errors occur in mathematical functions.  Type "man matherr"
  66.  *    for more information on how this function works.
  67.  *
  68.  * Results:
  69.  *    Returns 1 to indicate that we've handled the error
  70.  *    locally.
  71.  *
  72.  * Side effects:
  73.  *    Sets errno based on what's in xPtr.
  74.  *
  75.  *----------------------------------------------------------------------
  76.  */
  77.  
  78. int
  79. matherr(xPtr)
  80.     struct exception *xPtr;    /* Describes error that occurred. */
  81. {
  82.     if (!tcl_MathInProgress) {
  83.     return 0;
  84.     }
  85.     if ((xPtr->type == DOMAIN) || (xPtr->type == SING)) {
  86.     errno = EDOM;
  87.     } else {
  88.     errno = ERANGE;
  89.     }
  90.     return 1;
  91. }
  92.